00100	C  THIS PROGRAM CREATES FUNCTIONS FOR THE MUSIC PROGRAM USING 
00200	C  'SEG' OR 'SYNTH'.  UP TO 10 FUNCTIONS CAN BE STORED IN A
00300	C  SINGLE FILE.  ONCE CREATED, THE FUNCTIONS MAY BE CHANGED
00400	C  AND PUT BACK IN THE SAME FILE OR INTO A NEW ONE.
00500	C  NO MORE THAN 50 INPUTS FOR ONE FUNCTION!
00600	C  TYPE 'C' (= CRUNCH)  FOR SPECIAL FEATURE SUBR.
00700	C  'Z' FOR "CHANGE OR FINISH?" WILL JUMP DIRECTLY TO "CRUNCH" MODE.
00800	C  WITH S(EE), <CR> WILL REPEAT SEE COMMAND WITHOUT ASKING FOR FILE.
00900	C  'SP' (FOR "SEE") WILL PLOT ONE AT A TIME.
01000	C  'SA' PLOTS ALL IN .DAT FILE ON CALCOMP
01100	C  'SX' PLOTS ALL IN XGP FORMAT. (1ST→ <CTRL C>, A DSK PTP  --
01200	C -- WHEN DONE→ <CTRL C>, F )  THEN USE "X" PROG. TYPE 6,11,1.
01300	C FOR EXPONENTIALS GET INTO 'SEG'.  TYPE 'X', DECAY FAC, N.  IF 
01400	C  N IS NON-ZERO THE FUNCTION WILL NOT! NORMALIZE (IE. NOT GO TO 0).
01500	C  AFTER A FILE HAS BEEN READ IN, 
01600	C  <CR> FOR 'TYPE FILE' WILL HOLD ON TO IT.
01700	C  LOAD WITH -- WRIFUN,FUSUB,DFUNC,CURSOR,SSS,%LTVRLIB[1,TVR]
01800		COMMON/LN/LINE
01900		COMMON/S/H,AMP,CON,PH
02000		COMMON/RD/ A(50,4),B(2,10),FN(10),XA(10),AA(4,178,10)
02100		1,LX,JX,JT,IDEL,FNUM,FNUM1,Z,FLNM,FLNM1,KT
02200		COMMON FUNC(512),F2(512),K,I
02300		DIMENSION RF(4)
02400	21	FORMAT(' C=CHANGE, F=FINISH  '$)
02500	22	FORMAT(' NEW FUNC, EDIT, CRUNCH, DELETE, RENAME, SEE?   '$)
02600	23	FORMAT(' SEG OR SYNTH?   '$)
02700	24	FORMAT(' TYPE FUNCTION NAME   '$)
02800	25	FORMAT(' TYPE FILE NAME   '$)
02900	26	FORMAT(I3,') TYPE AMPL, STEP# -- OR L=LTPEN   '$)
03000	C  'X' HERE WILL MAKE EXPON. FUNC.
03100	28	FORMAT(' 0=NORM,OR H,A,P,K   '$)
03200	280	FORMAT(' NEW VERSION!  --REPORT ANY PROBLEMS TO LCS'/
03300		1' UP TO 10 FUNCTIONS MAY BE STORED IN EACH FILE'/
03400		1' TYPE "B" TO BACKUP AT ANY TIME'//)
03500	30	FORMAT(8F)
03600	31	FORMAT(1XA5,A1,5A5/)
03700	34	FORMAT(A5,'(',A5,');',A5)
03800	35	FORMAT(1XA5,'IN FILE "',A5,'.DAT"'/)
03900	37	FORMAT(8F9.3)
04000	371	FORMAT(I3,') ',4F8.2)
04100	372	FORMAT(I,21F)
04200	38	FORMAT(2(A5,A1),23A2)
04300	40	FORMAT(11(A1,A3))
04400	41	FORMAT(' ADD TO AN EXISTING FILE?   '$)
04500	42	FORMAT(' WHICH FUNC?   '$)
04600	47	FORMAT(' C=CHNG, I=INSRT, D=DEL -- + LN# & CHNGS '$)
04700	48	FORMAT(' X,N(=DECAY FAC.) FOR XPONTLS')
04800	2281	TYPE 280
04900	281	KZ=0
05000	C   USED IN RELATIVE VECTOR ROUTINE
05100		Z=0
05200		XZ=0
05300		EY=0
05400		ICUR=0
05500		XP=0
05600		KT=0
05700		FNUM=0
05800		OLD=0
05900		FNUM1=0
06000		TYPE 22
06100		ACCEPT 40,ON,P
06200		PLTALL=0
06300		IF(P.EQ.'A'.OR.P.EQ.'X')PLTALL=-1
06400	1281	IPLOT=0
06500		XDPY=-1
06600		IF(ON.EQ.'N'.OR.(ON.EQ.' '.AND.ONX.NE.'S'))GO TO 1000
06700		IF(ON.NE.' ')GO TO 100
06800		ON=ONX
06900		XDPY=0
07000	C  <CR> FOR 'SEE' WILL DISPLAY UP TO 3 FUNCS AT ONCE.
07100	C  RETURNS FOR MORE "SEE"
07200		GO TO 4281
07300	100	ONX=ON
07400		TYPE 25
07500		OLD=-1
07600		ACCEPT 38,FLNM1
07700		IF(FLNM1.EQ.' ')FLNM1=FLNM
07800		IF(FLNM1.EQ.0.OR.LOOKD(FLNM1).EQ.0)GO TO 100
07900		IF(FLNM.NE.FLNM1)GO TO 2151
08000		OLD=0
08100	4281	TYPE 40,B
08200		IF(PLTALL)GO TO 5402
08300		GO TO 1402
08400	2151	FLNM=FLNM1
08500		CALL READ1
08600	3402	JX=-1
08700		LX=0
08800		IF(PLTALL)GO TO 402
08900	C  "SA" WILL PLOT ALL FUNCS IN FILE
09000		TYPE 40,B
09100		IF(B(1,2).NE.' ')GO TO 1402
09200		FNUM1=B(2,1)
09300	C  ONLY ONE FUNC IN FILE.
09400		GO TO 402
09500	1402	TYPE 42
09600		ACCEPT 40,BU
09650		IF(BU.EQ.' ')GO TO 1402
09700		IF(BU.EQ.'B')GO TO 281
09800		REREAD 38,FNUM1
09900		IDEL=0
10000	C  LX IS MAIN COUNTER
10100		IF(OLD)GO TO 402
10200		DO 1302 JX=1,10
10300	1302	IF(FNUM1.EQ.FN(JX))GO TO 5402
10400		GO TO 3402
10500	402	CALL READER
10600	C  AT THIS POINT LX=TOTAL FUNCS+1
10700	5402	IF(PLTALL)JX=1
10800	1202	IF(ON.NE.'C'.AND.ON.NE.'S'.AND.ON.NE.'D')GO TO 3281
10900		IF(XDPY)CALL DPYX(1)
11000		CALL DPYF(JX,FUNC)
11100		IF(PLTALL.OR.P.EQ.'P'.OR.P.EQ.0)GO TO 2202
11200		IF(ON.EQ.'S')GO TO 2281
11300		IF(ON.EQ.'C')GO TO 1201
11400	1140	TYPE 1139
11500		ACCEPT 40,IDEL
11600		IF(IDEL.EQ.'N')GO TO 2281
11610		IF(IDEL.NE.'Y')GO TO 1140
11700		IDEL=JX
11800		LX=LX-1
11900	C  NOW LX=TOTAL # OF FUNCS.
12000		CALL WRIFUN
12100	1139	FORMAT(' DELETE IT? ',$)
12200	2202	CALL PLOTIT(FUNC,XA(JX),P)
12300		IF(P.EQ.'P')GO TO 2281
12400		JX=JX+1
12500		IF(B(2,JX).NE.' '.AND.JX.LE.10)GO TO 1202
12600	C  "SA" KEEPS PLOTTING UNTIL NO MORE ARE FOUND
12700		GO TO 2281
12800	3281	X=' '
12900		TYPE 31,XA(JX),X,FN(JX)
13000		JT=4
13100		IF(XA(JX).EQ.'SEG')JT=2
13200		KZ=1
13300		DO 137	K=1,50
13400		KZ=KZ+1
13500		DO 138 L=1,JT
13600	138	A(K,L)=AA(L,K,JX)
13700	137	IF(A(K,1).EQ.999.OR.A(K,2).GE.100)GO TO 4401
13800	
13900	4401	Z=-1
14000		IF(A(K,2).LE.100)GO TO 4403
14100		IF(K.GT.1)GO TO 4404
14200		CALL DPYX(1)
14300		CALL DPYF(JX,FUNC)
14400		IF(ON.EQ.'R')GO TO 3032
14500		TYPE 4405
14600		A(1,2)=520
14700		GO TO 4201
14800	4404	TYPE 4402
14900	4403	IF(JT.EQ.2)EY='EG'
15000		GO TO 1032
15100	4402	FORMAT('  IT WAS SMOOTHED.')
15200	4405	FORMAT(' CANNOT EDIT CRUNCHED FUNCS.'/)
15300	1000	TYPE 23
15400		ACCEPT 40,BU
15500		IF(BU.EQ.'B')GO TO 281
15600		REREAD 40,X,EY
15700	1032	CALL ZERO(FUNC)
15800	C  CLEARS THE FUNC.
15900		ISMOO=0
16000		IF(EY.EQ.'EG')GO TO 800
16100	151	EY=0
16200		JT=4
16300	C  FOR WRIFUN
16400	1031	CALL DPYX(1)
16500	15	KT=1
16600	104	IF(Z.EQ.-1.OR.KT.LT.KZ)GO TO 102
16700		IF(Z.EQ.1)GO TO 2032
16800	1041	KZ=0
16900		TYPE 28
17000		ACCEPT 40,BU
17100		IF(BU.EQ.'B')GO TO 509
17200		REREAD 30,(A(KT,K),K=1,4)
17300	C ACCEPT HARM,AMPL,PHASE,KONSTANT(IF K>100, MULTIPLIES WAVE *(K-100))
17400	102	H=A(KT,1)
17500		IF(H.EQ.0.OR.H.EQ.999.)GO TO 2200
17600	C   999 ENDS 'READIN' SYNTHS
17700		IF(Z.GT.0)TYPE 371,KT,(A(KT,K),K=1,4)
17800		AMP=A(KT,2)
17900		PH=A(KT,3)
18000		CON=A(KT,4)
18100		CALL SYN(FUNC)
18200		KT=KT+1
18300		IF(KZ.LE.KT)CALL DPY(FUNC,1)
18400		GO TO 104
18500	2201	IF(JT.NE.2.OR.A(KT-1,2).GT.100)GO TO 1201
18600	C  TO USE CURRENT FUNC IN CRUNCH
18700		IF(LX.GT.10)GO TO 204
18800		CALL STORE(10)
18900	C  PUTS FROM A ARRAY TO AA ARRAY
19000		XA(K)='SEG'
19100		CALL DPYX(1)
19200		CALL DPYF(K,FUNC)
19300	1201	CALL ZFUNC
19400	C  THIS WILL BE FOR SPECIAL FEATURE PACKAGE
19500		IF(KT.EQ.512)GO TO 2281
19600	C  FOR BACKUP
19700	4201	EY='EG'
19800		KT=2
19900		GO TO 900
20000	2200	CALL NORM(FUNC)
20100	C   NORMALIZES THE FUNCTION
20200		CALL DPY(FUNC,1)
20300	201	IF(BU.EQ.'C')GO TO 2032
20400		IF(ON.EQ.'R')GO TO 3032
20500	204	TYPE 21
20600		IF(EY.EQ.'EG')TYPE 271
20700	C   CHANGE IT?
20800		ACCEPT 40,BU
20900		IF(BU.EQ.'C')GO TO 210
21000		IF(BU.EQ.'F')GO TO 900
21100		IF(BU.EQ.'S')GO TO 7000
21200		IF(BU.EQ.'Z')GO TO 2201
21300	C  TO USE CURRENT FUNC IN CRUNCH
21400		IF(BU.NE.'B')GO TO 2032
21500		IF(EY.EQ.'EG')GO TO 509
21600		GO TO 5091
21700	C   NEXT IS FOR CHANGES ('C' OR <CR>)
21800	2032	TYPE 47
21900		ACCEPT 40,K
22000		REREAD 372,L,X,RF
22100		IF(X.NE.0.OR.RF(1).NE.0)GO TO 211
22200		IF(EY.EQ.'EG')GO TO 204
22300		BU=0
22400		GO TO 1041
22500	211	L=X
22600		IF(K.EQ.'I')GO TO 212
22700		IF(K.NE.'D')GO TO 205
22800	C   JUMP IF NO DELETE
22900		KT=KT-1
23000		DO 209 K=L,KT
23100		DO 209 J=1,4
23200	209	A(K,J)=A(K+1,J)
23300		GO TO 210
23400	205	X=RF(2)
23500		IF(EY.NE.'EG')GO TO 1207
23600		IF(X.GE.A(L+1,2).AND.L.LT.KT-1)GO TO 2032
23700		GO TO 208
23800	212	IF(RF(2).NE.0)GO TO 213
23900		RF(2)=RF(1)
24000		RF(1)=X
24100		L=KT
24200	213	IF(EY.NE.'EG')GO TO 214
24300		X=RF(2)
24400		DO 215 K=1,KT
24500		Y=A(K,2)
24600		IF(X.GT.Y)GO TO 215
24700	C   JUMP IF NOT PAST STEP NUM.
24800		L=K
24900		IF(X.EQ.Y)GO TO 208
25000	C   IF STEP=ANOTHER STEP, IT WORKS LIKE 'C'HANGE.
25100		GO TO 214
25200	215	CONTINUE
25300	214	KT=KT+1
25400		DO 206 K=KT,L,-1
25500		DO 206 J=1,4
25600	206	A(K,J)=A(K-1,J)
25700		GO TO 207
25800	C   TO TYPE OLD NUMBERS
25900	208	IF(X.LE.A(L-1,2).AND.L.GT.1)GO TO 2032
26000	1207	TYPE 371,L,(A(L,K),K=1,4)
26100	207	DO 202 K=1,4
26200	202	A(L,K)=RF(K)
26300	210	KZ=KT
26400		Z=1
26500		GO TO 1032
26600	271	FORMAT('+S=SMOOTH  '$)
26700	C  FOR RENAMES
26800	3032	Z=-1
26900		GO TO 901
27000	900	TYPE 41
27100	C  ADD TO EXISTING FILE
27200		ISKP=0
27300		ACCEPT 40,Z
27400	9000	IF(Z.EQ.'B')GO TO 204
27500		IF(Z.NE.'Y'.AND.Z.NE.'N')GO TO 900
27600		TYPE 25
27700		ACCEPT 38,FLNM
27800		IF(FLNM.EQ.' '.AND.FLNM1.NE.' ')FLNM=FLNM1
27900		IF(FLNM.EQ.'B'.OR.FLNM.EQ.' ')GO TO 204
28000	CC	IF(LOOKD(FLNM).AND.Z.EQ.'N')GO TO 902
28100		IF(LOOKD(FLNM))GO TO 902
28200		IF(Z.NE.'N')GO TO 900
28300	C  LOOKD CHECKS ON LOOK-UP
28400	901	JT=4
28500		IF(EY.EQ.'EG')JT=2
28600		CALL WRIFUN
28700		GO TO 900
28800	C  COMES BACK IF NO ROOM IN FILE FOR NEW FUNC.
28900	902	IF(Z.NE.'N')GO TO 901
29000		TYPE 381,FLNM
29100		ACCEPT 40,Z
29200		IF(Z.NE.'N')GO TO 901
29300		GO TO 9000
29400	381	FORMAT(' WRITE OVER ',A5,'.DAT?  ',$)
29500	
29600	161	DO 261 K=1,512
29700	261	FUNC(K)=EXP((1-K)/STEP)
29800		KT=2
29900		XP=-1
30000		IF(H.NE.0)GO TO 7009
30100	C  H≠0 = NO NORMALIZATION OF XPONTL
30200		X=FUNC(512)
30300		DO 361 K=1,512
30400	361	FUNC(K)=FUNC(K)-(K-1)/511.*X
30500		GO TO 7009
30600	800	IF(XP)GO TO 510
30700		X=0
30800		JT=2
30900	C  JT AND EY SEEM TO PERFORM THE SAME FUNCTIONS??
31000		Y=0
31100		KT=1
31200		N=-256
31300		CALL DPYX(2)
31400		CALL DPYBRT(5)
31500	504	IF(KT.GE.KZ)GO TO 510
31600		AMP=A(KT,1)
31700	5008	STEP=A(KT,2)
31800		IF(STEP.LE.A(KT-1,2).AND.KT.GT.1)GO TO 509
31900	C   SO IT CAN'T GO BACKWARDS
32000		GO TO 5071
32100	434	ICUR=0
32200		CALL CLRCUR
32300		GO TO 510
32400	C   EXIT FROM CURSOR
32500	CC431	CALL SETCUR(-256,128,0)
32600	431	NX=-256
32700		NY=128
32800		NZ=0
32900	C  TYPE <CR> HERE TO SET FIRST POINT AT 0,0
33000		ICUR=-1
33100	433	CALL SETCUR(NX,NY,NZ)
33200		NZ=1
33300	C  =1 TO DRAG ALONG VECTOR
33400		TYPE 432,KT
33500		ACCEPT 40,AB
33600		IF(AB.EQ.'B')GO TO 509
33700		IF(AB.EQ.'R')GO TO 434
33800		MX=NX
33900		MY=NY
34000		CALL RDCUR(NX,NY)
34100	CC	CALL SETCUR(NX,NY,1)
34200		STEP=(NX+256)/5.12
34300		AMP=(NY-128)/256.
34400		IF(KT.EQ.1)STEP=1.
34500		IF(STEP.LT.100)GO TO 5571
34600		AMP=((STEP-100)/(STEP-A(KT-1,2)))*(A(KT-1,1)-AMP)+AMP
34700		ICUR=0
34800		CALL CLRCUR
34900		STEP=100.
35000	5571	TYPE 37,AMP,STEP
35100		GO TO 5071
35200	611	FORMAT(' NO MORE THAN 50 SEGS'/)
35300	610	TYPE 611
35400	509	KT=KT-1
35500	CC	IF(ICUR)CALL SETCUR(MX,MY,1)
35600	5091	IF(KT.LT.1)GO TO 281
35700		GO TO 210
35800	432	FORMAT(I3,') <CR>=SEG, B=BACKUP, R=RETURN  '/)
35900	510	IF(ICUR)GO TO 433
36000		IF(KT.EQ.1)TYPE 48
36100		TYPE 26,KT
36200		KZ=0
36300		ACCEPT 40,BU
36400		IF(BU.EQ.'B')GO TO 509
36500		IF(BU.EQ.'L')GO TO 431
36600	61	REREAD 30,AMP,STEP,H
36700		IF(STEP.LT.1)STEP=1
36800		IF(BU.EQ.'X')GO TO 161
36900	C  TYPE 'X' FOR EXPON. FUNC. + DECAY FACTOR, +1 = NO NORM.
37000	C  WE START WITH STEP 1 (NOT 0)
37100	5071	IF(KT.GT.50)GO TO 610
37200	C   TOO MANY SEGS
37300		IF(Z.GT.0)TYPE 371,KT,AMP,STEP
37400		IF(STEP.GT.100)STEP=100
37500		DIF=AMP-Y
37600		IF(STEP-X.LE.0.AND.KT.NE.1)GO TO 504
37700	C   SO IT CAN'T BACKUP HERE
37800		IF(STEP.LE.1.)Y=AMP
37900	203	YSTP=STEP
38000		IF(YSTP.GT.1)GO TO 1203
38100		YSTP=0
38200		X=-1
38300	1203	JJX=X*5.120-256
38400		NX=YSTP*5.120-256
38500		NY=AMP*256.+128.
38600		IZ=Y*256.+128.
38700		CALL ALINE(JJX,IZ,NX,NY)
38800		CALL DPYOUT(1)
38900	12	Y=AMP
39000		X=YSTP
39100		A(KT,1)=Y
39200	CC	A(KT,2)=X
39300		A(KT,2)=STEP
39400	7001	KT=KT+1
39500	C   KT COUNTS SEGMENTS
39600		IF(STEP.LT.100)GO TO 504
39700		GO TO 201
39800	
39900	7000	IF(ISMOO)GO TO 201
40000		IF(KT.LE.20)GO TO 7007
40100		TYPE 7008
40200		GO TO 509
40300	7008	FORMAT(' NO MORE THAN 20 SEGS IN CURVES'/)
40400	7007	CALL SSS(A,KT-1,FUNC)
40500	C   DRAWS GRID 2
40600	7009	CALL DPY(FUNC,2)
40700		A(KT-1,2)=520
40800		ISMOO=-1
40900	C  SO YOU CAN'T COME BACK 2 TIMES
41000		GO TO 201
41100		END